library(tidyverse)
library(openintro)
library(albersusa)
library(plotly)
burden <- read_csv("RentCostBurden.csv")
elections <- read_csv("elections.csv")
election_county <- read_csv("election_county.csv")
Exercise 1
us_states = usa_sf("laea")
## old-style crs object detected; please recreate object with a recent sf::st_crs()
us_county = counties_sf("laea")
## old-style crs object detected; please recreate object with a recent sf::st_crs()
# Create theme to remove background elements
my_map_theme <- function(){
theme(panel.background=element_blank(),
axis.text=element_blank(),
axis.ticks=element_blank(),
axis.title=element_blank())
}
burden_county <- burden %>%
filter(Type=="County") %>%
select(Location, Overall_Burden_Rate_18, Median_Rent_18) %>%
separate(Location, c("county", "state"), sep=", ")
# Join map data and rent median data
us_county_burden <- left_join(counties_sf("laea"), burden_county, c("name"="county"))
## old-style crs object detected; please recreate object with a recent sf::st_crs()
ggplot() +
geom_sf(data = us_county_burden, aes(fill=Overall_Burden_Rate_18), size = 0.5) +
geom_sf(data = usa_sf(), alpha=0, size=0.5, color="black") +
scale_fill_continuous(low="yellow", high="red", labels = scales::comma) +
guides(fill = guide_colorbar("Overall_Burden_Rate_18", title.position="top")) +
my_map_theme()
## old-style crs object detected; please recreate object with a recent sf::st_crs()

Exercise 2
elections <- elections %>%
select(state, d_points_2012, d_points) %>%
rename('2012' = d_points_2012, '2016' = d_points) %>%
pivot_longer(c('2012', '2016'), names_to = 'Year', values_to="MofV")
my_cutpoints <- c(-100,-15,-5,-1,0,1,5,15,100)
my_labels <- c("R+15 or more", "R+5 to R+15", "R+1 to R+5", "R+0 to R+1",
"D+0 to D+1", "D+1 to D+5", "D+5 to D+15", "D+15 or more")
election_state <- us_states %>%
left_join(elections, c("name"="state")) %>%
mutate(margin = cut(MofV, breaks = my_cutpoints, labels = my_labels))
my_colors <- c("#b2182b","#d6604d","#f4a582","#fddbc7",
"#d1e5f0","#92c5de","#4393c3","#2166ac")
ggplot(election_state) +
facet_wrap(~Year, nrow = 2) +
geom_sf(aes(fill=margin)) +
my_map_theme() +
scale_fill_manual("", values = my_colors) +
labs(title = "Presidential Election Results by State",
subtitle = "Percentage Margin of Victory by Clinton (D) or Trump (R)") +
theme(plot.title = element_text(hjust = 0.5, size=15)) +
theme(plot.subtitle = element_text(hjust = 0.5))

Exercise 3
When we try to join on us_county by fips, we get an error because the fips column in the election_county table is of type factor and the fips column in the us_county table is of type double. R can’t check for equality between these values because they are of incompatible.
margin_election <- election_county %>%
mutate(d_points_2016 = (per_dem_2016 - per_gop_2016) *100) %>%
mutate(d_points_2016 = cut(d_points_2016, breaks = my_cutpoints, labels = my_labels))
us_county <- mutate(us_county, fips2 = as.numeric(as.character(fips)))
us_election_county <- left_join(us_county, margin_election, c("fips2" = "fips"))
ggplot(us_election_county) +
geom_sf(aes(fill=d_points_2016)) +
geom_sf(data = usa_sf(), alpha=0, size=0.5, color="black") +
my_map_theme()+
scale_fill_manual("", values = my_colors)
## old-style crs object detected; please recreate object with a recent sf::st_crs()

us_county_WA <- us_county %>%
filter(state == "Washington")
us_election_county_WA <- left_join(us_county_WA, margin_election, c("fips2" = "fips"))
ggplot(us_election_county_WA) +
geom_sf(aes(fill=d_points_2016)) +
my_map_theme()+
scale_fill_manual("", values = my_colors)

us_election_county_West <- inner_join(us_county, margin_election, c("fips2" = "fips"))
us_election_county_West <- us_election_county_West %>%
filter(census_region == "West")
region <- election_county %>%
filter(census_region == "West")
us_west_border <- inner_join(us_states, region, c("iso_3166_2" = "state"))
ggplot(us_election_county_West) +
geom_sf(aes(fill=d_points_2016)) +
geom_sf(data = us_west_border, alpha=0, size=0.5, color="black") +
my_map_theme()+
scale_fill_manual("", values = my_colors)

Exercise 0
rent_state <- burden %>%
filter(Type=="State") %>%
select(Location, Median_Rent_18)
us_states_rent <- left_join(us_states, rent_state, c("name" = "Location"))
p <- us_states_rent %>%
mutate(text = paste("<b>", name ,"</b>\n2018 Median Rent rate: ", Median_Rent_18, sep="")) %>%
ggplot() +
geom_sf(aes(fill=Median_Rent_18+runif(nrow(us_states_rent)), text=text)) +
scale_fill_continuous(low="yellow", high="red", labels = scales::comma) +
guides(fill = guide_colorbar("Median Rent ($)", title.position="top")) +
my_map_theme()
## Warning: Ignoring unknown aesthetics: text
ggplotly(p, tooltip = "text") %>%
style(hoveron = "fills")
LS0tDQp0aXRsZTogIkZlYnJ1YXJ5IDI1IEluLUNsYXNzOiBFbGVjdGlvbiBNYXBzIg0KYXV0aG9yOiAiU2FueWFwb29tIFNpcmlqaXJha2FybiINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCm91dHB1dDogb3BlbmludHJvOjpsYWJfcmVwb3J0DQotLS0NCg0KYGBge3IgbG9hZC1wYWNrYWdlcywgbWVzc2FnZT1GQUxTRX0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShvcGVuaW50cm8pDQpsaWJyYXJ5KGFsYmVyc3VzYSkNCmxpYnJhcnkocGxvdGx5KQ0KYnVyZGVuIDwtIHJlYWRfY3N2KCJSZW50Q29zdEJ1cmRlbi5jc3YiKQ0KZWxlY3Rpb25zIDwtIHJlYWRfY3N2KCJlbGVjdGlvbnMuY3N2IikNCmVsZWN0aW9uX2NvdW50eSA8LSByZWFkX2NzdigiZWxlY3Rpb25fY291bnR5LmNzdiIpDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDENCg0KDQpgYGB7ciB9DQp1c19zdGF0ZXMgPSB1c2Ffc2YoImxhZWEiKQ0KdXNfY291bnR5ID0gY291bnRpZXNfc2YoImxhZWEiKQ0KDQoNCiMgQ3JlYXRlIHRoZW1lIHRvIHJlbW92ZSBiYWNrZ3JvdW5kIGVsZW1lbnRzDQpteV9tYXBfdGhlbWUgPC0gZnVuY3Rpb24oKXsNCiAgdGhlbWUocGFuZWwuYmFja2dyb3VuZD1lbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGV4dD1lbGVtZW50X2JsYW5rKCksDQogICAgICAgIGF4aXMudGlja3M9ZWxlbWVudF9ibGFuaygpLA0KICAgICAgICBheGlzLnRpdGxlPWVsZW1lbnRfYmxhbmsoKSkNCn0NCg0KYnVyZGVuX2NvdW50eSA8LSBidXJkZW4gJT4lDQogIGZpbHRlcihUeXBlPT0iQ291bnR5IikgJT4lDQogIHNlbGVjdChMb2NhdGlvbiwgT3ZlcmFsbF9CdXJkZW5fUmF0ZV8xOCwgTWVkaWFuX1JlbnRfMTgpICU+JQ0KICBzZXBhcmF0ZShMb2NhdGlvbiwgYygiY291bnR5IiwgInN0YXRlIiksIHNlcD0iLCAiKSANCg0KIyBKb2luIG1hcCBkYXRhIGFuZCByZW50IG1lZGlhbiBkYXRhDQp1c19jb3VudHlfYnVyZGVuIDwtIGxlZnRfam9pbihjb3VudGllc19zZigibGFlYSIpLCBidXJkZW5fY291bnR5LCBjKCJuYW1lIj0iY291bnR5IikpDQoNCmdncGxvdCgpICsgDQogIGdlb21fc2YoZGF0YSA9IHVzX2NvdW50eV9idXJkZW4sIGFlcyhmaWxsPU92ZXJhbGxfQnVyZGVuX1JhdGVfMTgpLCBzaXplID0gMC41KSArDQogIGdlb21fc2YoZGF0YSA9IHVzYV9zZigpLCBhbHBoYT0wLCBzaXplPTAuNSwgY29sb3I9ImJsYWNrIikgKw0KICBzY2FsZV9maWxsX2NvbnRpbnVvdXMobG93PSJ5ZWxsb3ciLCBoaWdoPSJyZWQiLCBsYWJlbHMgPSBzY2FsZXM6OmNvbW1hKSArDQogIGd1aWRlcyhmaWxsID0gZ3VpZGVfY29sb3JiYXIoIk92ZXJhbGxfQnVyZGVuX1JhdGVfMTgiLCB0aXRsZS5wb3NpdGlvbj0idG9wIikpICsNCiAgbXlfbWFwX3RoZW1lKCkNCg0KDQpgYGANCg0KIyMjIEV4ZXJjaXNlIDINCg0KYGBgIHtyfQ0KIGVsZWN0aW9ucyA8LSBlbGVjdGlvbnMgJT4lDQogIHNlbGVjdChzdGF0ZSwgZF9wb2ludHNfMjAxMiwgZF9wb2ludHMpICU+JQ0KICByZW5hbWUoJzIwMTInID0gZF9wb2ludHNfMjAxMiwgJzIwMTYnID0gZF9wb2ludHMpICU+JQ0KICBwaXZvdF9sb25nZXIoYygnMjAxMicsICcyMDE2JyksIG5hbWVzX3RvID0gJ1llYXInLCB2YWx1ZXNfdG89Ik1vZlYiKQ0KDQpteV9jdXRwb2ludHMgPC0gYygtMTAwLC0xNSwtNSwtMSwwLDEsNSwxNSwxMDApDQpteV9sYWJlbHMgPC0gYygiUisxNSBvciBtb3JlIiwgIlIrNSB0byBSKzE1IiwgIlIrMSB0byBSKzUiLCAiUiswIHRvIFIrMSIsDQoiRCswIHRvIEQrMSIsICJEKzEgdG8gRCs1IiwgIkQrNSB0byBEKzE1IiwgIkQrMTUgb3IgbW9yZSIpDQoNCmVsZWN0aW9uX3N0YXRlIDwtIHVzX3N0YXRlcyAlPiUNCmxlZnRfam9pbihlbGVjdGlvbnMsIGMoIm5hbWUiPSJzdGF0ZSIpKSAlPiUNCm11dGF0ZShtYXJnaW4gPSBjdXQoTW9mViwgYnJlYWtzID0gbXlfY3V0cG9pbnRzLCBsYWJlbHMgPSBteV9sYWJlbHMpKQ0KDQoNCg0KbXlfY29sb3JzIDwtIGMoIiNiMjE4MmIiLCIjZDY2MDRkIiwiI2Y0YTU4MiIsIiNmZGRiYzciLA0KIiNkMWU1ZjAiLCIjOTJjNWRlIiwiIzQzOTNjMyIsIiMyMTY2YWMiKQ0KDQpgYGANCg0KYGBgIHtyfQ0KZ2dwbG90KGVsZWN0aW9uX3N0YXRlKSArDQogIGZhY2V0X3dyYXAoflllYXIsIG5yb3cgPSAyKSArDQogIGdlb21fc2YoYWVzKGZpbGw9bWFyZ2luKSkgKw0KICBteV9tYXBfdGhlbWUoKSArDQogIHNjYWxlX2ZpbGxfbWFudWFsKCIiLCB2YWx1ZXMgPSBteV9jb2xvcnMpICsNCiAgbGFicyh0aXRsZSA9ICJQcmVzaWRlbnRpYWwgRWxlY3Rpb24gUmVzdWx0cyBieSBTdGF0ZSIsDQogIHN1YnRpdGxlID0gIlBlcmNlbnRhZ2UgTWFyZ2luIG9mIFZpY3RvcnkgYnkgQ2xpbnRvbiAoRCkgb3IgVHJ1bXAgKFIpIikgKw0KICB0aGVtZShwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41LCBzaXplPTE1KSkgKw0KICB0aGVtZShwbG90LnN1YnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC41KSkNCmBgYA0KDQojIyMgRXhlcmNpc2UgMw0KDQpXaGVuIHdlIHRyeSB0byBqb2luIG9uIHVzX2NvdW50eSBieSBmaXBzLCB3ZSBnZXQgYW4gZXJyb3IgYmVjYXVzZSB0aGUgZmlwcyBjb2x1bW4gaW4gdGhlIGVsZWN0aW9uX2NvdW50eSB0YWJsZSBpcyBvZiB0eXBlIGZhY3RvciBhbmQgdGhlIGZpcHMgY29sdW1uIGluIHRoZSB1c19jb3VudHkgdGFibGUgaXMgb2YgdHlwZSBkb3VibGUuIFIgY2Fu4oCZdCBjaGVjayBmb3IgZXF1YWxpdHkgYmV0d2VlbiB0aGVzZSB2YWx1ZXMgYmVjYXVzZSB0aGV5IGFyZSBvZiBpbmNvbXBhdGlibGUuDQoNCmBgYCB7cn0NCm1hcmdpbl9lbGVjdGlvbiA8LSBlbGVjdGlvbl9jb3VudHkgJT4lDQogIG11dGF0ZShkX3BvaW50c18yMDE2ID0gIChwZXJfZGVtXzIwMTYgLSBwZXJfZ29wXzIwMTYpICoxMDApICU+JQ0KICBtdXRhdGUoZF9wb2ludHNfMjAxNiA9IGN1dChkX3BvaW50c18yMDE2LCBicmVha3MgPSBteV9jdXRwb2ludHMsIGxhYmVscyA9IG15X2xhYmVscykpDQoNCnVzX2NvdW50eSA8LSBtdXRhdGUodXNfY291bnR5LCBmaXBzMiA9IGFzLm51bWVyaWMoYXMuY2hhcmFjdGVyKGZpcHMpKSkNCg0KdXNfZWxlY3Rpb25fY291bnR5IDwtIGxlZnRfam9pbih1c19jb3VudHksIG1hcmdpbl9lbGVjdGlvbiwgYygiZmlwczIiID0gImZpcHMiKSkNCmBgYA0KDQpgYGAge3J9DQpnZ3Bsb3QodXNfZWxlY3Rpb25fY291bnR5KSArDQogIGdlb21fc2YoYWVzKGZpbGw9ZF9wb2ludHNfMjAxNikpICsNCiAgZ2VvbV9zZihkYXRhID0gdXNhX3NmKCksIGFscGhhPTAsIHNpemU9MC41LCBjb2xvcj0iYmxhY2siKSArDQogIG15X21hcF90aGVtZSgpKw0KICBzY2FsZV9maWxsX21hbnVhbCgiIiwgdmFsdWVzID0gbXlfY29sb3JzKQ0KYGBgDQoNCmBgYCB7cn0NCnVzX2NvdW50eV9XQSA8LSB1c19jb3VudHkgJT4lDQogIGZpbHRlcihzdGF0ZSA9PSAiV2FzaGluZ3RvbiIpDQoNCnVzX2VsZWN0aW9uX2NvdW50eV9XQSA8LSBsZWZ0X2pvaW4odXNfY291bnR5X1dBLCBtYXJnaW5fZWxlY3Rpb24sIGMoImZpcHMyIiA9ICJmaXBzIikpDQoNCmdncGxvdCh1c19lbGVjdGlvbl9jb3VudHlfV0EpICsNCiAgZ2VvbV9zZihhZXMoZmlsbD1kX3BvaW50c18yMDE2KSkgKw0KICBteV9tYXBfdGhlbWUoKSsNCiAgc2NhbGVfZmlsbF9tYW51YWwoIiIsIHZhbHVlcyA9IG15X2NvbG9ycykNCmBgYA0KYGBgIHtyfQ0KdXNfZWxlY3Rpb25fY291bnR5X1dlc3QgPC0gaW5uZXJfam9pbih1c19jb3VudHksIG1hcmdpbl9lbGVjdGlvbiwgYygiZmlwczIiID0gImZpcHMiKSkNCg0KdXNfZWxlY3Rpb25fY291bnR5X1dlc3QgPC0gdXNfZWxlY3Rpb25fY291bnR5X1dlc3QgJT4lDQogIGZpbHRlcihjZW5zdXNfcmVnaW9uID09ICJXZXN0IikNCg0KcmVnaW9uIDwtIGVsZWN0aW9uX2NvdW50eSAlPiUNCiAgZmlsdGVyKGNlbnN1c19yZWdpb24gPT0gIldlc3QiKQ0KDQp1c193ZXN0X2JvcmRlciA8LSBpbm5lcl9qb2luKHVzX3N0YXRlcywgcmVnaW9uLCBjKCJpc29fMzE2Nl8yIiA9ICJzdGF0ZSIpKQ0KDQoNCmdncGxvdCh1c19lbGVjdGlvbl9jb3VudHlfV2VzdCkgKw0KICBnZW9tX3NmKGFlcyhmaWxsPWRfcG9pbnRzXzIwMTYpKSArDQogIGdlb21fc2YoZGF0YSA9IHVzX3dlc3RfYm9yZGVyLCBhbHBoYT0wLCBzaXplPTAuNSwgY29sb3I9ImJsYWNrIikgKw0KICBteV9tYXBfdGhlbWUoKSsNCiAgc2NhbGVfZmlsbF9tYW51YWwoIiIsIHZhbHVlcyA9IG15X2NvbG9ycykNCmBgYA0KDQojIyMgRXhlcmNpc2UgMA0KDQoNCmBgYCB7cn0NCnJlbnRfc3RhdGUgPC0gYnVyZGVuICU+JQ0KICBmaWx0ZXIoVHlwZT09IlN0YXRlIikgJT4lDQogIHNlbGVjdChMb2NhdGlvbiwgTWVkaWFuX1JlbnRfMTgpDQoNCnVzX3N0YXRlc19yZW50IDwtIGxlZnRfam9pbih1c19zdGF0ZXMsIHJlbnRfc3RhdGUsIGMoIm5hbWUiID0gIkxvY2F0aW9uIikpDQoNCnAgPC0gdXNfc3RhdGVzX3JlbnQgJT4lDQogIG11dGF0ZSh0ZXh0ID0gcGFzdGUoIjxiPiIsIG5hbWUgLCI8L2I+XG4yMDE4IE1lZGlhbiBSZW50IHJhdGU6ICIsIE1lZGlhbl9SZW50XzE4LCBzZXA9IiIpKSAlPiUNCiAgZ2dwbG90KCkgKw0KICAgIGdlb21fc2YoYWVzKGZpbGw9TWVkaWFuX1JlbnRfMTgrcnVuaWYobnJvdyh1c19zdGF0ZXNfcmVudCkpLCB0ZXh0PXRleHQpKSArDQogICAgc2NhbGVfZmlsbF9jb250aW51b3VzKGxvdz0ieWVsbG93IiwgaGlnaD0icmVkIiwgbGFiZWxzID0gc2NhbGVzOjpjb21tYSkgKw0KICAgIGd1aWRlcyhmaWxsID0gZ3VpZGVfY29sb3JiYXIoIk1lZGlhbiBSZW50ICgkKSIsIHRpdGxlLnBvc2l0aW9uPSJ0b3AiKSkgKw0KICAgIG15X21hcF90aGVtZSgpIA0KDQpnZ3Bsb3RseShwLCB0b29sdGlwID0gInRleHQiKSAlPiUNCiAgc3R5bGUoaG92ZXJvbiA9ICJmaWxscyIpIA0KYGBgDQoNCg==